home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / f2pop.zip / F2POP.PRG next >
Text File  |  1993-05-24  |  9KB  |  372 lines
  1.  
  2. #include "inkey.ch"
  3. #include "dbedit.ch"
  4.  
  5. // AutoSelect() demonstration
  6.  
  7. USE Manager NEW
  8. INDEX ON UPPER(mgr_cd) TO Manager1
  9.  
  10. USE Rep New
  11. INDEX ON UPPER(Mgr_cd+rep_cd) TO Rep1
  12.  
  13. cCust_cd := SPACE(3)
  14. cMgr_cd  := SPACE(3)
  15. cMgrName := SPACE(20)
  16. cRep_cd  := SPACE(3)
  17. cRepName := SPACE(20)
  18. cCompany := SPACE(20)
  19.  
  20. SETKEY(K_F2, { |cP,nL,cV| PointnShoot(cP,nL,cV) } )
  21. SETCOLOR("7+/1,4/7,,,6+/1") 
  22. SCROLL()
  23.  
  24. @ 06,01 SAY "F2Pop Demo"
  25. @ 23,01 SAY "<Esc> Quit"
  26. DO WHILE LASTKEY()# K_ESC
  27.    @ 09,01 SAY "Customer Information:"
  28.    @ 10,03 SAY "Cust Account #.. " GET cCust_cd
  29.    @ 11,03 SAY "Manager Code.... " GET cMgr_cd  WHEN F2msg(.T.) VALID F2msg(.F.)
  30.    @ 12,03 SAY "Manager's Name.. " GET cMgrName WHEN (.F.)
  31.    @ 13,03 SAY "Sales Rep Code.. " GET cRep_Cd  WHEN F2msg(.T.) VALID F2msg(.F.)
  32.    @ 14,03 SAY "Sales Rep's Name " GET cRepName WHEN (.F.)
  33.    @ 15,03 SAY "Account Name.... " GET cCompany
  34.    READ
  35. ENDDO
  36.  
  37. SETKEY(K_F2, NIL)
  38.  
  39. *******************
  40. FUNCTION F2Msg(lOn)
  41. *******************
  42. LOCAL nRow:=IIF(READVAR()=="CMGR_CD",11,13)
  43. IF lOn
  44.    @ nRow,26 SAY "══ <F2> Lookup"
  45. ELSE
  46.    @ nRow,26 
  47. ENDIF
  48. RETURN (.T.)
  49.  
  50. ******************************
  51. FUNCTION PointnShoot(cP,nL,cV)
  52. ******************************
  53. LOCAL ;
  54. lRetval:=(.T.),;
  55. cOldScr:=SAVESCREEN(0,0,24,79)
  56. STATIC lIsRunning:=(.F.)
  57. IF lIsRunning
  58.    RETURN lRetval
  59. ENDIF
  60. lIsRunning:=(.T.)
  61. IF cV=="CREP_CD"
  62.    lRetval:= AutoSelect(17,22,"Rep",1,UPPER(cMgr_cd),"UPPER(Mgr_cd)",;
  63.              "mgr_cd+'│'+rep_cd+'│'+name","Mgr Rep Rep Name            ",;
  64.              @cRep_cd,"rep_cd",@cRepName,"name")
  65. ELSEIF cV=="CMGR_CD"
  66.    lRetval:= AutoSelect(17,22,"Manager",1,,,;
  67.              "mgr_cd+'│'+name","Mgr Mgr Name            ",;
  68.              @cMgr_cd,"mgr_cd",@cMgrName,"name")
  69. ENDIF
  70. RESTSCREEN(0,0,24,79,cOldScr)
  71. lIsRunning:=(.F.)
  72. RETURN lRetval
  73.  
  74.  
  75. // End Demo
  76.  
  77. *******************
  78. FUNCTION AutoSelect
  79. *******************
  80. /*  
  81. ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  82. By: A.J. Grace - CIS 72410,350
  83. Syntax: AutoSelect(<nTop>, <nBot>, <cAlias>, <nIndexOrd>,
  84.                    [<cSearchKey>], [<cLiteral>], <cFnames>, <cColHeader>,
  85.                    [<@cGetVar1>], [<cGetField1>], [<@cGetVar2>], [<cGetField2>])
  86.  
  87. Arguments:
  88. <nTop>, <nBot> upper and lower coordinates of DBEDIT()
  89. <cAlias>       current workarea
  90. <nIndexOrd>    current index order setting
  91. [<cSearchKey>] primary key expression of index file
  92. [<cLiteral>]   literal prinary key expression of index file
  93. <cFnames>      database field names and/or character strings, [pictures]
  94. <cColHeader>   columm headers
  95. [<cGetVar1>]   current get name (reference variable)
  96. [<cGetField1>] source data field loading into cGetVar
  97. [<cGetVar2>]   current get name (reference variable)
  98. [<cGetField2>] source data field loading into cGetVar
  99.  
  100. * you may want to add more reference variables as needed
  101.  
  102. Description:
  103. AutoSelect() uses DBEDIT() but it sports several distinctive features such as:
  104. 1.) Displaying a subset of records based on the key expression of an index file.
  105. 2.) Allows the user to search the display scope of records by simply typing the
  106.     search key from within DBEDIT()
  107. 3.) Selecting a record <K_ENTER> will populate the current get with its value.
  108.  
  109. RETURNs (.T.) IF a, selection was made
  110.  
  111. ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
  112. */
  113. LOCAL cOldArea:=SELECT()
  114.  
  115. PARAMETERS;   
  116. nTop    ,;
  117. nBot    ,;
  118. cAlias  ,;
  119. nIndexOrd,;
  120. cSearchKey,;
  121. cLiteral ,;
  122. cFnames ,;
  123. cColHeader,;
  124. cGetVar1 ,;
  125. cGetField1,;
  126. cGetVar2 ,;
  127. cGetField2
  128.  
  129. IF cSearchKey==NIL
  130.    cSearchKey:=""
  131.    cLiteral:="Disabled"
  132.    Disabled:=""
  133. ENDIF
  134.  
  135. PRIVATE ;
  136. cScanBar[1],;
  137. cScanTitle[1],;
  138. nCurRec,;
  139. nBegRec,;
  140. nEndRec,;
  141. nRow          := ROW(),;
  142. nCol          := COL(),;
  143. cBuffer       := "",;
  144. cBoundsErr    := "'" + cSearchKey + "'#" + cLiteral ,;
  145. cMacroSub     := "cSearchKey",;
  146. nWidth        := LEN(cColHeader)
  147.  
  148. cScanBar[1]   := [ IIF(]+cMacroSub+[#]+cLiteral+[,SPACE(nWidth),]+cFnames+[) ]
  149. cScanTitle[1] := cColHeader
  150. nLeft         := (80-LEN(cScanTitle[1])) / 2
  151. nRight        := nLeft+LEN(cScanTitle[1])
  152.  
  153. dbSelectArea(cAlias)
  154. dbSetOrder(nIndexOrd)
  155. dbSeek(cSearchKey)
  156.  
  157. // set pointer flags
  158. nCurRec    := RECNO()
  159. nBegRec    := RECNO()
  160. nEndRec    := EndRec(cSearchKey)
  161.  
  162. @ nTop-1,nLeft-1 TO nBot+1,nRight+1 DOUBLE
  163. DBEDIT(nTop,nLeft,nBot,nRight,cScanBar,"ScanUdf",,cScanTitle)
  164.  
  165. @ nRow,nCol SAY ""
  166. SELECT(cOldArea)
  167. RETURN (LASTKEY()=K_ESC)
  168.  
  169. *********************************
  170. FUNCTION ScanUdf(nStatus,nFldPtr)
  171. *********************************
  172. PRIVATE;
  173. nRequest,;
  174. nLastKey := LASTKEY()
  175.  
  176. nRequest := SubSetTest()
  177. IF nRequest # 0 
  178.    RETURN nRequest
  179. ENDIF
  180.  
  181. SetUpSearch(nLastKey)
  182.  
  183. IF nStatus=DE_IDLE
  184.    nRequest := ScanIdle(nLastKey)
  185.  
  186. ELSEIF nStatus=DE_HITTOP
  187.    Msg( "Beginning of file." )
  188.    nRequest := DE_CONT
  189.  
  190. ELSEIF nStatus=DE_HITBOTTOM
  191.    Msg( "End of file." )
  192.    nRequest := DE_CONT
  193.  
  194. ELSEIF nStatus=DE_EMPTY
  195.    Msg( "No records on file." )
  196.    nRequest := DE_REFRESH
  197.  
  198. ELSEIF nStatus=DE_EXCEPT
  199.    // all others go this way 
  200.    nRequest := ScanExcept(nLastKey)
  201.  
  202. ENDIF
  203.  
  204. // track the current record number
  205. nCurRec := RECNO()
  206.  
  207. RETURN nRequest
  208.  
  209. **********************************
  210. STATIC FUNCTION ScanIdle(nLastKey)
  211. **********************************
  212. RETURN IIF(nLastKey=K_ESC,DE_ABORT,DE_CONT)
  213.  
  214. ************************************
  215. STATIC FUNCTION ScanExcept(nLastKey)
  216. ************************************
  217. LOCAL;
  218. nRetval := DE_CONT,;
  219. nCurRecNo
  220.  
  221. IF nLastKey = K_ESC
  222.    // Exit dbedit()
  223.    nRetval := DE_ABORT
  224.  
  225. ELSEIF nLastKey = K_ENTER
  226.    /* 
  227.       Pass a value back to your GET (Point n Shoot) 
  228.    */
  229.  
  230.    IF cGetVar1 # NIL
  231.       cGetVar1  := &cGetField1.
  232.       IF cGetVar2 # NIL
  233.          cGetVar2 := &cGetField2.
  234.       ENDIF
  235.       KEYBOARD CHR(K_ESC) + CHR(K_ENTER)
  236.    ENDIF
  237.  
  238. ELSEIF nLastKey = K_DEL
  239.    // Put your delete routine here
  240.  
  241. ELSEIF nLastKey = K_INS
  242.    // Put your add routine here to insert a line
  243.    nRetval:=DE_REFRESH // refresh screen
  244.  
  245. ELSE
  246.  
  247.    // use this for you search routine
  248.    nCurRecNo := RECNO()
  249.    cBuffer   := cBuffer + UPPER(CHR(nLastKey))
  250.    SEEK cSearchKey + cBuffer
  251.  
  252.    IF FOUND()
  253.       nRetval:=IIF(RECNO()=nCurRecNo,DE_CONT,DE_REFRESH)
  254.    ELSE
  255.       // reset search buffer
  256.       cBuffer := ""
  257.       Msg("Search terminated.")
  258.       // put your go_to() routine goes in here
  259.       Go_To( nCurRecNo )
  260.    ENDIF
  261.  
  262. ENDIF
  263. RETURN nRetval
  264.  
  265. **************************
  266. STATIC FUNCTION SubSetTest
  267. **************************
  268. LOCAL;
  269. nRetval    := DE_ABORT,;
  270. lBoundsErr := (&cBoundsErr. .OR.BOF().OR.EOF()) .AND. CursorKeys(nLastKey),;
  271. cDirection := ;
  272. IIF(nLastKey=K_UP.OR.nLastKey=K_PGUP.OR.nLastKey=K_CTRL_PGUP,"UP",;
  273. IIF(nLastKey=K_DOWN.OR.nLastKey=K_PGDN.OR.nLastKey=K_CTRL_PGDN,"DOWN",""))
  274.  
  275. // Out of bounds error occured during a cursor key press
  276. IF lBoundsErr
  277.  
  278.    // test for last direction of cursor then reset pointer appropriately
  279.    IF cDirection="UP"
  280.       Go_To(nCurRec)
  281.       Msg("First record on file.")
  282.    ELSEIF cDirection="DOWN"
  283.       Go_To(nEndRec)
  284.       Msg("Last record on file.")
  285.    ENDIF
  286.  
  287.    // reset current pointer
  288.    nCurRec := RECNO()
  289.  
  290.    // reset search buffer
  291.    cBuffer := ""
  292.    nRetval := IIF(lBoundsErr, DE_CONT, DE_REFRESH)
  293.  
  294. ENDIF
  295.  
  296. RETURN nRetval
  297.  
  298. ************************************
  299. STATIC FUNCTION CursorKeys(nLastKey)
  300. ************************************
  301. RETURN ;
  302. nLastKey=K_PGUP      .OR.;
  303. nLastKey=K_CTRL_PGUP .OR.;
  304. nLastKey=K_PGDN      .OR.;
  305. nLastKey=K_CTRL_PGDN .OR.;
  306. nLastKey=K_DOWN      .OR.;
  307. nLastKey=K_UP        .OR.;
  308. nLastKey=K_ENTER     .OR.;
  309. nLastKey=K_DEL
  310.  
  311. ********************************
  312. STATIC FUNCTION SoftKey(cString)
  313. ********************************
  314. RETURN SUBSTR(cString,1,LEN(cString)-1)+CHR(ASC(RIGHT(cString,1))+1)
  315.  
  316. *******************************
  317. STATIC FUNCTION EndRec(cSearchKey)
  318. *******************************
  319. LOCAL;
  320. nEndRec,;
  321. nCurRec:=RECNO()
  322.  
  323. SET SOFTSEEK ON
  324. dbSeek( SoftKey(cSearchKey) )
  325. SET SOFTSEEK OFF
  326. SKIP -1
  327. nEndRec := RECNO()
  328.  
  329. Go_to( nCurRec )
  330.  
  331. RETURN nEndRec
  332.  
  333. **********************
  334. FUNCTION Msg(cMessage)
  335. **********************
  336. LOCAL cOldScr:=SAVESCREEN(24,0,24,79)
  337. @ 24,0
  338. @ 24,2 SAY cMessage
  339. INKEY(3)
  340. RESTSCREEN(24,0,24,79,cOldScr)
  341. RETURN NIL
  342.  
  343. **********************
  344. FUNCTION Go_To(nRecNo)
  345. **********************
  346. LOCAL nCurRec:=RECNO()
  347. IF nRecNo#0.AND.;
  348.    nRecNo<=RECCOUNT()+1.AND.;
  349.    nRecNo#RECNO()
  350.    IF nRecNo=RECCOUNT()+1
  351.       dbSkip(-1)
  352.    ELSE
  353.       dbGoto(nRecNo)
  354.    ENDIF
  355. ENDIF
  356. RETURN nCurRec
  357.  
  358. *************************************
  359. STATIC FUNCTION SetUpSearch(nLastKey)
  360. *************************************
  361. IF nLastKey=K_ENTER.OR.nLastKey=K_UP.OR.nLastKey=K_DOWN.OR.nLastKey=K_PGUP.OR.;
  362.    nLastKey=K_PGDN.OR.nLastKey=29.OR.nLastKey=30.OR.nLastKey=31.OR.;
  363.    nLastKey=23.OR.nLastKey=K_F5.OR.nLastKey=K_CTRL_RET
  364.    cKey:=""
  365. ENDIF
  366. RETURN NIL
  367.  
  368.  
  369.  
  370.  
  371.  
  372.